;;; 27-Jan-94 by amf:
;;; patch to ambiguity packing

; append-new-ambiguity  symbol2 will die.
; 5-Aug-87  for failure recovery, add "when sons are not equal" condition.
(defun append-new-ambiguity (symbol1 symbol2)
    (let ((node1 (node-ptr (symbol-array symbol1)))
	  (node2 (node-ptr (symbol-array symbol2)))
          (merge-list nil)
          (new-cat nil))
	 
         (setq new-cat (node-category (node-array node2)))
	 (when (listp new-cat)                          ; it's already merged
               (setq merge-list (fifth new-cat))
               (when (member node1 merge-list)
	             (return-from append-new-ambiguity nil)))
	 (when (>= *debug-level* 3)
	       (format *debug-out* "~& packing ~A(~D) to ~D"
		       (node-category (node-array node2)) node2 node1))
	 (when (or (not *parser-failed*)     ; when failed, do not pass here
		   (not (equal (sons (node-array node1))
			       (sons (node-array node2))))
		   (not (equal (value (node-array node1))
			       (value (node-array node2)))))
	       (setf (sons (aref *node-array* node1))
		     (append (sons (node-array node1))
			     (sons (node-array node2))))

	       (if *new-unify*
		   (setf (value (aref *node-array* node1))  ; then
			 (append-value node1 node2))
		   (setf (value (aref *node-array* node1))  ; else
			 (append (value (node-array node1))
				 (value (node-array node2))))
	       ))

          (when (listp new-cat)
                (setq new-cat (car new-cat)))
          (setq merge-list (cons node1 merge-list))
	  (setf (node-category (aref *node-array* node2))
	        (list new-cat 'is 'merged 'to merge-list))
	 ; to see to which it was merged
    ))

